home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / white.arc / CASE&DIS.4TH < prev    next >
Encoding:
Text File  |  1986-11-07  |  4.9 KB  |  194 lines
  1. \ CASE OF ENDOF ENDCASE -- fig-FORTH Decomplier       29Dec83RSW
  2. ( CASE control statement by Charles E. Eaker )
  3. ( published in FORTH Dimensions II/3 page 37 )
  4.         FORTH DEFINITIONS DECIMAL
  5. : CASE         ?COMP CSP @ SP@ CSP ! 4 ; IMMEDIATE
  6. : OF           4 ?PAIRS
  7.                COMPILE OVER COMPILE =
  8.                COMPILE 0BRANCH HERE 0 ,
  9.                COMPILE DROP 5 ; IMMEDIATE
  10. : ENDOF        5 ?PAIRS
  11.                COMPILE BRANCH HERE 0 ,
  12.                SWAP 2 [COMPILE] THEN 4 ; IMMEDIATE
  13. : ENDCASE      4 ?PAIRS COMPILE DROP
  14.                BEGIN SP@ CSP @ = 0=
  15.                WHILE 2 [COMPILE] THEN REPEAT
  16.                CSP ! ; IMMEDIATE
  17. \ fig-FORTH Decompiler -- load commands               30Dec83RSW
  18.  
  19.         FORTH DEFINITIONS DECIMAL
  20.  FORGET TASK
  21.  572 576 THRU
  22.  577 LOAD BEEP ." DIS decompiler ready " CR
  23.  
  24.         EXIT
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33. \ constants -- fig-FORTH Decompiler                   30Dec83RSW
  34.         FORTH DEFINITIONS DECIMAL  : TASK ;
  35. 0 VARIABLE QUIT.FLAG   0 VARIABLE WORD.PTR
  36. ( find run-time address of each vocabulary word type )
  37. ' <LOOP>       2 - CONSTANT     LOOP.ADR
  38. ' LIT          2 - CONSTANT     LIT.ADR
  39. ' :            2 - @ CONSTANT   DOCOL.ADR
  40. ' 0BRANCH      2 - CONSTANT     0BRANCH.ADR
  41. ' BRANCH       2 - CONSTANT     BRANCH.ADR
  42. ' <+LOOP>      2 - CONSTANT     PLOOP.ADR
  43. ' <.">         2 - CONSTANT     PDOTQ.ADR
  44. ' C/L          2 - @ CONSTANT   CONST.ADR
  45. ' BASE         2 - @ CONSTANT   USERV.ADR
  46. ' USE          2 - @ CONSTANT   VAR.ADR
  47. ' <;CODE>      2 - CONSTANT     PSCODE.ADR
  48.  
  49. \ constants cont -- fig-FORTH Decompiler              30Dec83RSW
  50.  
  51. ' </LOOP>      2 - CONSTANT     SLOOP.ADR
  52. ' <ABORT">     2 - CONSTANT     PABORTQ.ADR
  53. ' EXIT         2 - CONSTANT     EXIT.ADR
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65. \ N. PDOTQ.DSP WORD.DSP -- fig-FORTH Decompiler       30Dec83RSW
  66.         FORTH DEFINITIONS DECIMAL
  67. : N.            ( print a number in decimal and hex )
  68.                 DUP DECIMAL . SPACE
  69.                 HEX 0 ." ( " D. ." H ) "   DECIMAL ;
  70.  
  71. : PDOTQ.DSP     ( display a compiled text string )
  72.                 WORD.PTR @ 2+ DUP >R DUP
  73.                 C@ + 1 - WORD.PTR !
  74.                 R> COUNT TYPE ;
  75.  
  76. : WORD.DSP      ( given CFA, display the glossary name )
  77.                 3 - -1 TRAVERSE DUP 1+ C@ 59 =
  78.                 IF 1 QUIT.FLAG ! THEN
  79.                 DUP C@ 160 AND 128 =
  80.                 IF ID. ELSE 1 QUIT.FLAG ! THEN  ;
  81. \ BRANCH.DSP USERV.DSP -- fig-FORTH Decompiler        30Dec83RSW
  82.  
  83. : BRANCH.DSP    ( get branch offset, calculate the )
  84.                 ( actual branch address, and display it )
  85.                 ." to "
  86.                 WORD.PTR @ 2+ DUP WORD.PTR !
  87.                 DUP @ +
  88.                 0 HEX D. DECIMAL              ;
  89.  
  90. : USERV.DSP     ( display a user variable )
  91.                 ." User variable, current value = "
  92.                 WORD.PTR @ 2+
  93.                 C@ [ HEX ] 38 UP @ + + [ DECIMAL ]
  94.                @ N.
  95.                 1 QUIT.FLAG !  ;
  96.  
  97. \ VAR.DSP CONST.DSP -- fig-FORTH Decompiler           30Dec83RSW
  98.  
  99. : VAR.DSP       ( display a variable )
  100.                 ." Variable, current value = "
  101.                 WORD.PTR @ 2+
  102.                 @ N.
  103.                 1 QUIT.FLAG ! ;
  104.  
  105. : CONST.DSP     ( display a compiled constant )
  106.                 ." Constant, value = "
  107.                 WORD.PTR @ 2+
  108.                 @ N.
  109.                 1 QUIT.FLAG !   ;
  110.  
  111.  
  112.  
  113. \ DIS -- fig-FORTH Decompiler                         29Dec83RSW
  114. : DIS
  115.   -FIND 0=
  116.   IF 3 SPACES ." ? not in glossary " CR
  117.   ELSE DROP DUP DUP 2 -
  118.   @ =
  119.   IF ." <primitive> " CR
  120.   ELSE
  121.   0 QUIT.FLAG !
  122.   2 - WORD.PTR !
  123.   CR CR
  124.   BEGIN
  125.   WORD.PTR @ DUP
  126.   0 HEX D. SPACE DECIMAL
  127.   @
  128. -->
  129. \ DIS cont -- fig-FORTH Decompiler                    30Dec83RSW
  130. CASE
  131. LIT.ADR OF
  132.                 WORD.PTR @ 2+ DUP WORD.PTR ! @ N. ENDOF
  133. DOCOL.ADR OF
  134.                 ." : "  ENDOF
  135. 0BRANCH.ADR OF
  136.                 ." Branch if zero "   BRANCH.DSP ENDOF
  137. BRANCH.ADR OF
  138.                 ." Branch "   BRANCH.DSP ENDOF
  139. LOOP.ADR OF
  140.                 ." Loop "     BRANCH.DSP ENDOF
  141. PLOOP.ADR OF
  142.                 ." +Loop "    BRANCH.DSP ENDOF
  143. SLOOP.ADR OF
  144.                 ." /Loop "    BRANCH.DSP ENDOF  -->
  145. \ DIS cont -- fig-FORTH Decompiler                    30Dec83RSW
  146. PDOTQ.ADR OF
  147.                 ." Print text: "   PDOTQ.DSP ENDOF
  148. PABORTQ.ADR OF
  149.                 ." Abort text: "   PDOTQ.DSP ENDOF
  150. USERV.ADR OF
  151.                 USERV.DSP ENDOF
  152. VAR.ADR OF
  153.                 VAR.DSP   ENDOF
  154. CONST.ADR OF
  155.                 CONST.DSP ENDOF
  156. PSCODE.ADR OF
  157.                 WORD.PTR @ @ WORD.DSP
  158.                 1 QUIT.FLAG ! ENDOF
  159. EXIT.ADR OF
  160.                 ." Exit " 1 QUIT.FLAG !  ENDOF  -->
  161. \ DIS cont -- fig-FORTH Decompiler                    30Dec83RSW
  162.  
  163.  
  164.  DUP WORD.DSP
  165.  
  166.  ENDCASE CR
  167.  2 WORD.PTR +!
  168.  QUIT.FLAG @
  169.  ?TERMINAL OR
  170.  UNTIL
  171.  THEN THEN CR ;           ( all done now )
  172.  
  173.  
  174.  
  175.  
  176.  EXIT
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193. QUIT.FLAG @
  194.  ?T